home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt40s2.arc / MAKEMENU.MOD < prev    next >
Text File  |  1987-04-01  |  5KB  |  112 lines
  1. (*----------------------------------------------------------------------*)
  2. (*                Make_A_Menu --- Set up a menu                         *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Make_A_Menu( VAR Menu     : Menu_Type;
  6.                            Size     : INTEGER;
  7.                            Row      : INTEGER;
  8.                            Column   : INTEGER;
  9.                            Width    : INTEGER;
  10.                            Height   : INTEGER;
  11.                            Default  : INTEGER;
  12.                            Title    : AnyStr;
  13.                            Texts    : AnyStr;
  14.                            GenLet   : BOOLEAN     );
  15.  
  16. (*----------------------------------------------------------------------*)
  17. (*                                                                      *)
  18. (*       Procedure:   Make_A_Menu                                       *)
  19. (*                                                                      *)
  20. (*       Purpose:     Set up a menu                                     *)
  21. (*                                                                      *)
  22. (*       Calling Sequence:                                              *)
  23. (*                                                                      *)
  24. (*          Make_A_Menu( VAR Menu     : Menu_Type;                      *)
  25. (*                           Size     : INTEGER;                        *)
  26. (*                           Row      : INTEGER;                        *)
  27. (*                           Column   : INTEGER;                        *)
  28. (*                           Width    : INTEGER;                        *)
  29. (*                           Height   : INTEGER;                        *)
  30. (*                           Default  : INTEGER;                        *)
  31. (*                           Title    : AnyStr;                         *)
  32. (*                           Texts    : AnyStr;                         *)
  33. (*                           GenLet   : BOOLEAN     );                  *)
  34. (*                                                                      *)
  35. (*             Menu    --- Menu to be initialized                       *)
  36. (*             Size    --- Number of entries in menu                    *)
  37. (*             Row     --- Row position of upper left hand corner       *)
  38. (*             Column  --- Column position of upper left hand corner    *)
  39. (*             Width   --- Width of menu                                *)
  40. (*             Height  --- Height of menu                               *)
  41. (*             Default --- Default entry for menu                       *)
  42. (*             Title   --- Title for menu                               *)
  43. (*             Texts   --- Texts of menu item entries, each ended by a  *)
  44. (*                         semicolon.                                   *)
  45. (*             GenLet  --- Add x) to front of each menu item.           *)
  46. (*                                                                      *)
  47. (*----------------------------------------------------------------------*)
  48.  
  49. VAR
  50.    I         : INTEGER;
  51.    Text_Pos  : INTEGER;
  52.    Prev_Pos  : INTEGER;
  53.    Null_Texts: BOOLEAN;
  54.  
  55. CONST
  56.    Letters  : ARRAY[1..26] OF CHAR =
  57.               ('a','b','c','d','e','f','g','h','i','j',
  58.                'k','l','m','n','o','p','r','s','t','u',
  59.                'v','w','x','y','z','q');
  60.  
  61. BEGIN (* Make_A_Menu *)
  62.                                    (* Set menu attributes *)
  63.    WITH Menu DO
  64.       BEGIN
  65.  
  66.          Menu_Size    := Size;
  67.          Menu_Row     := Row;
  68.          Menu_Column  := Column;
  69.          Menu_Tcolor  := Menu_Text_Color;
  70.          Menu_Hcolor  := Menu_Title_Color;
  71.          Menu_Bcolor  := BLACK;
  72.          Menu_Fcolor  := Menu_Frame_Color;
  73.          Menu_Width   := Width;
  74.          Menu_Height  := Height;
  75.          Menu_Default := Default;
  76.  
  77.       END (* WITH Menu *);
  78.  
  79.    Text_Pos   := 1;
  80.    Null_Texts := ( LENGTH( Texts ) = 0 );
  81.    GenLet     := GenLet AND ( NOT Null_Texts );
  82.  
  83.                                    (* Get menu item text *)
  84.    FOR I := 1 TO Size DO
  85.       WITH Menu.Menu_Entries[I] DO
  86.       BEGIN
  87.  
  88.          Menu_Item_Row    := I;
  89.          Menu_Item_Column := 2;
  90.          Prev_Pos         := Text_Pos;
  91.  
  92.          IF ( NOT Null_Texts ) THEN
  93.             BEGIN
  94.                WHILE( Texts[Text_Pos] <> ';' ) DO
  95.                   Text_Pos := SUCC( Text_Pos );
  96.                Menu_Item_Text   := SUBSTR( Texts, Prev_Pos, Text_Pos - Prev_Pos );
  97.                Text_Pos         := SUCC( Text_Pos );
  98.             END
  99.          ELSE
  100.             Menu_Item_Text[0] := #0;
  101.  
  102.          IF GenLet THEN
  103.             IF ( Menu_Item_Text <> 'Quit' ) THEN
  104.                Menu_Item_Text := Letters[I] + ') ' + Menu_Item_Text
  105.             ELSE
  106.                Menu_Item_Text := 'q) Quit';
  107.  
  108.       END;
  109.  
  110.    Menu.Menu_Title := Title;
  111.  
  112. END   (* Make_A_Menu *);